home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / tpcmag.arc / ENVIRON.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-05-19  |  1.9 KB  |  75 lines
  1. Program EnvDemo;
  2.    {from PC Magazine page 270, June 10, 1986 issue by James W. Harrison of
  3.    Richardson, TX.  For PC/MS-dos computers ONLY.  Works v2 TurboPascal
  4.    }
  5. type  envstr = String[128];
  6. var   I : integer;
  7.  
  8. function Environ (num:integer): EnvStr;
  9. var  i, EnvSeg, EnvOff, StrLen : integer;
  10. begin
  11.   EnvSeg := memw[cseg:$002c];
  12.   EnvOff := 0;
  13.   While (Num > 1) and (MemW[EnvSeg:EnvOff] <> 0) do begin
  14.     While Mem [EnvSeg:EnvOff] <> 0 do
  15.        EnvOff := EnvOff + 1;
  16.     Num := Num - 1;
  17.     EnvOff := EnvOff + 1;
  18.   end; {while}
  19.   StrLen := 0;
  20.   While Mem [EnvSeg:EnvOff] <> 0 do begin
  21.     StrLen := StrLen + 1;
  22.     Environ [StrLen] := Chr (Mem[EnvSeg:EnvOff]);
  23.     EnvOff := EnvOff + 1;
  24.     end; {while}
  25.   Environ[0] := Chr(strLen);
  26. end; { function Environ (num:integer) }
  27.  
  28. function GetEnv (EnvVar:EnvStr): EnvStr;
  29. var  i : integer;
  30.      try : EnvStr;
  31. begin
  32.   i := 1;
  33.   repeat
  34.     try := Environ(i);
  35.     i := i + 1;
  36.   until (length(try) = 0) or ((pos(EnvVar,Try) = 1)
  37.          and (try[length(EnvVar) + 1] = '='));
  38.   if length(try) <> 0 then
  39.     delete(try,1,length(envVar) + 1)
  40.   else try := '';
  41.   GetEnv := Try;
  42. end; { function GetEnv (EnvVar:EnvStr) }
  43.  
  44. function GetPath (num:integer): EnvStr;
  45. var PathStr : EnvStr;
  46.     i : integer;
  47. begin
  48.   PathStr := GetEnv ('PATH');
  49.   while num > 1 do begin
  50.     i := pos(';',PathStr);
  51.     if i = 0 then i := length(PathStr);
  52.     delete(PathStr, 1, i);
  53.     Num := Num - 1;
  54.   end;
  55.   if pos(';',PathStr) <> 0 then
  56.     PathStr := Copy (PathStr, 1, Pos (';',PathStr) - 1);
  57.   GetPath := PathStr;
  58. end; { function GetPath (num:integer) }
  59.  
  60. begin
  61.   i := 1;
  62.   while length(environ(i)) <> 0 do begin
  63.     writeln(environ(i));
  64.     i := i + 1;
  65.   end;
  66.   writeln;
  67.   writeln ('PATH Setting is ',GetEnv('PATH'));
  68.   writeln;
  69.   i := 1;
  70.   while length(getpath(i)) <> 0 do begin
  71.     writeln(getpath(i));
  72.     i := i + 1;
  73.     end;
  74. END.
  75.